home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / ovract.com / OVRACT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-11-22  |  4.7 KB  |  187 lines
  1. {
  2. OVRACT is a unit that captures data about the activities of the overlay
  3. manager in a Turbo Pascal 5.x program and saves it in a disk file.
  4.  
  5. To use it, add the unit OVRACT as near as possible to the beginning of the uses
  6. statement of your main program.  Compile and run the program normally.  If
  7. you are running DOS 3.0 or later, a file named ProgName.OVD will be produced,
  8. where ProgName is the root name of your EXE file.  Under earlier versions of
  9. DOS, a file named OVRACT.OVD is produced.
  10.  
  11. Written by Ron Schuster (CIS 76666,2322).  Copyright (c) 1989.
  12. All rights reserved.  May be distributed freely, but not for a profit.
  13.  
  14. This program was originally based on the overlay profiler OVRPROF
  15. written by Richard Casey (CIS 72247,151).
  16.  
  17. Portions of this program originally appeared in OVRSIZ by Kim Kokkonen,
  18. TurboPower Software (CIS 76004,2611), and were used with the permission of
  19. the author.  Copyright (c) 1989, TurboPower Software. All rights reserved.
  20. May be distributed freely, but not for a profit.
  21.  
  22.  
  23. Version 1.0, 11/21/89
  24. --------------------
  25.   Initial release.
  26. }
  27.  
  28. {$R-,S-,I-,V-,F-,B-,O-}
  29.  
  30.  
  31. unit OvrAct;
  32.  
  33. interface
  34.  
  35. implementation
  36.  
  37. uses
  38.   Dos, Overlay;
  39.  
  40. type
  41.   DispatcherHeader = record
  42.     ReturnInt : Word;
  43.     ReturnOfs : Word;
  44.     FileOfs : LongInt;
  45.     CodeSize : Word;
  46.     FixupSize : Word;
  47.     EntryPts : Word;
  48.     CodeListNext : Word;
  49.     LoadSegment : Word;
  50.     Reprieved : Word;
  51.     LoadListNext : Word;
  52.   end;
  53.  
  54.   ProcType = procedure;
  55.  
  56.   Words = record
  57.     Lo,Hi:Word;
  58.   end;
  59.  
  60. var
  61.   OvrDataFile : file of Word;
  62.   SaveExitProc : pointer;
  63.   StartTime : LongInt;
  64.   Ticks : LongInt absolute $40:$6C;
  65.   OldOvrHeapOrg,
  66.   OldOvrHeapEnd : Word;
  67.   SaveDebugPtr : pointer;
  68.   OvrDataFileName : PathStr;
  69.  
  70. const
  71.   EndListMark : Word = 0;
  72.   OvrHeapMark : Word = $FFFF;
  73.   FileFormatVersion : Word = 1;
  74.  
  75. procedure WriteCodeList;
  76. var
  77.   P : Word;
  78. begin
  79.   P := OvrCodeList;
  80.   while P <> 0 do begin
  81.     Write (OvrDataFile,P);
  82.     with DispatcherHeader(Ptr(P + PrefixSeg + $10, 0)^) do begin
  83.       Write (OvrDataFile, Words(FileOfs).Lo, Words(FileOfs).Hi,
  84.         CodeSize, FixupSize, EntryPts);
  85.       P := CodeListNext;
  86.     end;
  87.   end;
  88.   Write (OvrDataFile, EndListMark);
  89. end;
  90.  
  91. {$F+}
  92. procedure OvrDebug;
  93. var
  94.   Time : LongInt;
  95.   P : Word;
  96.   OvrSeg, OvrOfs: word;
  97. begin
  98.   Inline( $8C/$86/OvrSeg           { mov OvrSeg, es }
  99.          /$89/$9E/OvrOfs );        { mov OvrOfs, bx }
  100.  
  101.   if SaveDebugPtr <> nil then
  102.     ProcType(SaveDebugPtr);   { Let the debugger do its thing first }
  103.  
  104.   if FileRec(OvrDataFile).Mode = fmClosed then
  105.   { an overlaid unit's exit procedure must have happened after ours }
  106.     Exit;
  107.  
  108.   Time := Ticks - StartTime;
  109.   Write (OvrDataFile, Words(Time).Lo, Words(Time).Hi);
  110.  
  111.   if (OvrHeapOrg <> OldOvrHeapOrg) or (OvrHeapEnd <> OldOvrHeapEnd) then begin
  112.   { overlay buffer has changed, write new limits }
  113.     Write (OvrDataFile, OvrHeapMark, OvrHeapOrg, OvrHeapEnd);
  114.     OldOvrHeapOrg := OvrHeapOrg;
  115.     OldOvrHeapEnd := OvrHeapEnd;
  116.   end;
  117.  
  118.   Write (OvrDataFile, OvrSeg, OvrOfs);
  119.  
  120.   if DispatcherHeader(Ptr(OvrSeg,0)^).Reprieved = 0 then begin
  121.   { not a reprieve event, write load list }
  122.     P := OvrLoadList;
  123.     while P <> 0 do begin
  124.       Write (OvrDataFile, P, DispatcherHeader(Ptr(P,0)^).LoadSegment);
  125.       P := DispatcherHeader(Ptr(P,0)^).LoadListNext;
  126.     end;
  127.   end;
  128.   Write (OvrDataFile, EndListMark);
  129. end;
  130.  
  131. procedure OvrProfExit;
  132. begin
  133.   ExitProc := SaveExitProc;
  134.   Close (OvrDataFile);
  135. end;
  136. {$F-}
  137.  
  138. function HasExtension(Name : String; var DotPos : Word) : Boolean;
  139.   {-Return whether and position of extension separator dot in a pathname}
  140. var
  141.   I : Word;
  142. begin
  143.   DotPos := 0;
  144.   for I := Length(Name) downto 1 do
  145.     if (Name[I] = '.') and (DotPos = 0) then
  146.       DotPos := I;
  147.   HasExtension := (DotPos > 0) and (Pos('\', Copy(Name, Succ(DotPos), 64)) = 0);
  148. end;
  149.  
  150. function ForceExtension(Name, Ext : String) : String;
  151.   {-Return a pathname with the specified extension attached}
  152. var
  153.   DotPos : Word;
  154. begin
  155.   if HasExtension(Name, DotPos) then
  156.     ForceExtension := Copy(Name, 1, DotPos)+Ext
  157.   else
  158.     ForceExtension := Name+'.'+Ext;
  159. end;
  160.  
  161.  
  162. begin
  163.   OldOvrHeapOrg := 0;
  164.   OldOvrHeapEnd := 0;
  165.   StartTime := Ticks;
  166.   if Lo(Dos.DosVersion) < 3 then
  167.     OvrDataFileName := 'OvrAct.OVD'
  168.   else
  169.     OvrDataFileName := ForceExtension(ParamStr(0), 'OVD');
  170.  
  171.   assign (OvrDataFile, OvrDataFileName);
  172.   {$I-}
  173.   rewrite (OvrDataFile);
  174.   {$I+}
  175.   if IOResult <> 0 then begin
  176.     Writeln ('Could not open ', OvrDataFileName,' for output');
  177.     Halt(1);
  178.   end;
  179.   SaveExitProc := ExitProc;
  180.   ExitProc := @OvrProfExit;
  181.   SaveDebugPtr := OvrDebugPtr;
  182.   OvrDebugPtr := @OvrDebug;
  183.   Write (OvrDataFile, FileFormatVersion, PrefixSeg);
  184.   WriteCodeList;
  185. end.
  186.  
  187.